home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
DB_CLIPP
/
1159.ZIP
/
REPINSTP.PRG
< prev
next >
Wrap
Text File
|
1987-02-06
|
12KB
|
598 lines
IF GLPRINT=1
PAPEROUT=1
ENDIF
DO CASE
CASE MULTTV=1.AND.MODFILE=0
CLOSE DATABASES
SELECT 2
USE REPWORK
SELECT 1
USE &DBNAME INDEX &INDEX1,&INDEX2
SEEK TVANO
IF EOF()
CLEAR
@ 1,20 SAY 'Data base in use: '
?? OSS
@ 5,0 SAY 'No record was found in which "'
?? TVANO
??'" exactly '
?'matched any item in the '
?? TVANUMBER
??' field.'
?
?
?
WAIT
RETURN
ENDIF
DO WHILE TVANO=TVA_NO
SELECT 2
APPEND BLANK
REPLACE SUBCATID WITH A->SUBCATID
REPLACE INST_TYPE WITH A->INST_TYPE
REPLACE TVA_NO WITH A->TVA_NO
REPLACE SERIAL_NO WITH A->SERIAL_NO
REPLACE BY_DATE WITH A->BY_DATE
REPLACE CALIB_DATE WITH A->CALIB_DATE
REPLACE CAL_DUE_DT WITH A->CAL_DUE_DT
REPLACE LOCATION WITH A->LOCATION
REPLACE REMARK WITH A->REMARK
REPLACE CALIB_INT WITH A->CALIB_INT
REPLACE LAST_UPDAT WITH A->LAST_UPDAT
SELECT 1
SKIP
ENDDO
SELECT 2
CASE MULTSN=1.AND.MODFILE=0
CLOSE DATABASES
SELECT 2
USE REPWORK
SELECT 1
USE &DBNAME INDEX &INDEX2,&INDEX1
SEEK TVANO
IF EOF()
CLEAR
@ 1,20 SAY 'Data base in use: '
?? OSS
@ 5,0 SAY 'No record was found in which "'
?? TVANO
??'" exactly '
?'matched any item in the '
?? SERIALNUM
??' field.'
?
?
?
WAIT
RETURN
ENDIF
DO WHILE TVANO=SERIAL_NO
SELECT 2
APPEND BLANK
REPLACE SUBCATID WITH A->SUBCATID
REPLACE INST_TYPE WITH A->INST_TYPE
REPLACE TVA_NO WITH A->TVA_NO
REPLACE SERIAL_NO WITH A->SERIAL_NO
REPLACE BY_DATE WITH A->BY_DATE
REPLACE CALIB_DATE WITH A->CALIB_DATE
REPLACE CAL_DUE_DT WITH A->CAL_DUE_DT
REPLACE LOCATION WITH A->LOCATION
REPLACE REMARK WITH A->REMARK
REPLACE CALIB_INT WITH A->CALIB_INT
REPLACE LAST_UPDAT WITH A->LAST_UPDAT
SELECT 1
SKIP
ENDDO
SELECT 2
ENDCASE
IF GLCALDU=0
SET FILTER TO CALIB_INT#0 .AND. CALIB_INT#99
ELSE
SET FILTER TO COMPDATE1<=CAL_DUE_DT.AND.COMPDATE2>=CAL_DUE_DT.AND.;
BY_DATE>10
ENDIF
GO TOP
NNN=0
N99=0
NN=0
IF PRINTOUT=1
READY='K'
DO WHILE READY#'Y'
IF GLCALDU=0
CLEAR
?
?'Make SURE the printer is ready to print. Then press "Y" to continue,'
?
?'or else press "RETURN" to return to a previous menu.'
?
?
?'PLEASE NOTE: If you should ever make a mistake and there is a system error'
?'because the printer is not ready, then FIRST enable the printer and THEN'
?'press "I" for the "ignor" option until no further error is indicated.'
IF ADDFILE=1.OR.MODFILE=1
?'Since you are involved in a record modification routine at this time, any'
?'other response may damage the records to this particular data base and'
?'cause you to have to restore the records to this data base from a backup'
?'copy. For further information, please see the instruction manual.'
ENDIF
?
?
CLEAR TYPEAHEAD
WAIT ' ' TO READY
READY=UPPER(READY)
IF ASC(READY)=0
SET DELETED ON
IF (MULTTV=1.OR.MULTSN=1).AND.MODFILE=0
ZAP
USE
SELECT 1
ENDIF
RETURN
ENDIF
ELSE
READY='Y'
ENDIF
ENDDO
ENDIF
CLEAR
@ 4,35 SAY 'WORKING . . .'
@ 14,20 SAY 'Data base in use:'
@ 14,38 SAY OSS
IF PRINTOUT=1
N=5
SET CONSOLE OFF
SET PRINT ON
SET DEVICE TO PRINT
DO CASE
CASE ADDFILE=1
IF PDELREC=0
@ 1,45 SAY "These are the records you just added."
ELSE
@ 1,42 SAY "These are the records which were just deleted."
ENDIF
CASE MODFILE=1
IF PDELREC=0
@ 1,44 SAY "These are the records you just modified."
ELSE
@ 1,44 SAY "These are the records you just deleted."
ENDIF
CASE GLCALDU=1
@ 1,65-INT((LEN(DUEDATE)+62)/2) SAY 'Conditions: Records with '
?? DUEDATE
??' field from '
?? COMPDATE1
??' to '
?? COMPDATE2
??'.'
ENDCASE
@ 3,65-INT(LEN(TITLE1)/2) SAY TITLE1
@ 3,105 SAY "Today's date is"
@ 3,122 SAY DATE()
@ 3,130 SAY '.'
DO WHILE NN=0
DO WHILE .NOT. EOF()
DO CASE
CASE NNN=0
IF INSTNAME#'.'
@ N,0 SAY INSTNAME
ENDIF
IF SERIALNUM#'.'
@ N,21 SAY SERIALNUM
ENDIF
IF TVANUMBER#'.'
@ N,36 SAY TVANUMBER
ENDIF
IF CALIBDATE#'.'
@ N,51 SAY CALIBDATE
ENDIF
IF DUEDATE#'.'
@ N,61 SAY DUEDATE
ENDIF
IF LOCATNAME#'.'
@ N,95 SAY LOCATNAME
ENDIF
IF CALINTERVL#'.'
@ N,110 SAY CALINTERVL
ENDIF
@ N,120 SAY 'LAST UPDATE'
IF CALINTERVL#'.'
@ N+1,110 SAY '(months)'
ENDIF
@ N+2,0 SAY ' '
CASE NNN=1
?
DO CASE
CASE PROW()>53
@ 0,65-INT((LEN(CATEGORY2+CATEGORY3)+67)/2) SAY 'THESE RECORDS ARE;
EITHER PRESENTLY IN CATEGORY "'
?? CATEGORY2
??'" OR IN CATEGORY "'
?? CATEGORY3
??'"'
OTHERWISE
@ PROW(),65-INT((LEN(CATEGORY2+CATEGORY3)+67)/2) SAY 'THESE RECORDS ARE;
EITHER PRESENTLY IN CATEGORY "'
?? CATEGORY2
??'" OR IN CATEGORY "'
?? CATEGORY3
??'"'
ENDCASE
IF INSTNAME#'.'
@ PROW()+2,0 SAY INSTNAME
ENDIF
IF SERIALNUM#'.'
@ PROW(),21 SAY SERIALNUM
ENDIF
IF TVANUMBER#'.'
@ PROW(),36 SAY TVANUMBER
ENDIF
IF CALIBDATE#'.'
@ PROW(),51 SAY CALIBDATE
ENDIF
IF DUEDATE#'.'
@ PROW(),63 SAY DUEDATE
ENDIF
IF LOCATNAME#'.'
@ PROW(),95 SAY LOCATNAME
ENDIF
@ PROW(),120 SAY 'LAST UPDATE'
?
?
ENDCASE
DO WHILE .NOT. EOF()
DO CASE
CASE NNN=0
IF PROW()>53
EXIT
ENDIF
DO CASE
CASE BY_DATE=100
@ PROW()+1,51 SAY TDREMARK
CASE BY_DATE=200
@ PROW()+1,51 SAY DREMARK
ENDCASE
@ PROW()+1,0 SAY INST_TYPE
@ PROW(),21 SAY SERIAL_NO
@ PROW(),36 SAY TVA_NO
@ PROW(),51 SAY CALIB_DATE
@ PROW(),61 SAY CAL_DUE_DT
@ PROW(),70 SAY CDOW(CAL_DUE_DT)
??', '
?? CMONTH(CAL_DUE_DT)
?? DAY(CAL_DUE_DT)
@ PROW(),95 SAY LOCATION
@ PROW(),113 SAY CALIB_INT
@ PROW(),121 SAY LAST_UPDAT
PT=0
IF CAT3ABB $ SUBCATID
?'/'
?? CATEGORY3
??'/ '
PT=1
ENDIF
IF SUB1ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT1
??') '
PT=1
ELSE
??'('
?? SUBCAT1
??') '
ENDIF
ENDIF
IF SUB2ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT2
??') '
PT=1
ELSE
??'('
?? SUBCAT2
??') '
ENDIF
ENDIF
IF SUB3ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT3
??') '
ELSE
??'('
?? SUBCAT3
??') '
ENDIF
ENDIF
IF LEN(TRIM(REMARK))#0
? TRIM(REMARK)
ENDIF
CASE NNN=1
IF PROW()>53
EXIT
ENDIF
@ PROW()+1,0 SAY INST_TYPE
@ PROW(),21 SAY SERIAL_NO
@ PROW(),36 SAY TVA_NO
REMKE=LTRIM(TRIM(REMARK))
IF DTOC(CALIB_DATE) # ' / / ' .OR. CALIBDATE # '.'
@ PROW(),51 SAY CALIB_DATE
ENDIF
IF DTOC(CAL_DUE_DT) # ' / / ' .OR. DUEDATE # '.'
@ PROW(),69 SAY CAL_DUE_DT
ENDIF
DO CASE
CASE CALIB_INT=99
@ PROW(),78 SAY CATEGORY2
CASE CALIB_INT=0
@ PROW(),78 SAY CATEGORY3
ENDCASE
@ PROW(),95 SAY LOCATION
@ PROW(),121 SAY LAST_UPDAT
PT=0
IF CAT3ABB $ SUBCATID
?'/'
?? CATEGORY3
??'/ '
PT=1
ENDIF
IF SUB1ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT1
??') '
PT=1
ELSE
??'('
?? SUBCAT1
??') '
ENDIF
ENDIF
IF SUB2ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT2
??') '
PT=1
ELSE
??'('
?? SUBCAT2
??') '
ENDIF
ENDIF
IF SUB3ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT3
??') '
ELSE
??'('
?? SUBCAT3
??') '
ENDIF
ENDIF
IF LEN(REMKE)>0
? REMKE
ENDIF
N99=0
ENDCASE
SKIP
NSPC=1
DO WHILE NSPC<SPACING
?
NSPC=NSPC+1
ENDDO
ENDDO
?
N=0
ENDDO
IF NNN=0
IF GLCALDU=0
SET FILTER TO CALIB_INT=0 .OR. CALIB_INT=99
ELSE
SET FILTER TO COMPDATE1<=CAL_DUE_DT.AND.COMPDATE2>=CAL_DUE_DT.AND.;
BY_DATE<10
ENDIF
GO TOP
IF .NOT. EOF()
N99=1
ENDIF
ENDIF
NNN=1
IF N99=0
NN=1
ENDIF
?'****************************************************************************;
*******************************************************'
IF N99=1 .AND. NNN=1 .AND. PROW()>43
@ 0,0 SAY ' '
ENDIF
ENDDO
?
?'****************************************************************************;
*******************************************************'
?
?' END OF LISTING'
NPRN=0
DO WHILE NPRN<PAPEROUT
?
NPRN=NPRN+1
ENDDO
SET CONSOLE ON
SET DEVICE TO SCREEN
SET PRINT OFF
ENDIF
IF VIEW=1
SET FILTER TO
ENDREC=RECCOUNT()
GO TOP
DO WHILE .NOT. EOF()
SET CONSOLE ON
CLEAR
DO CASE
CASE ENDREC # 1
@ 1,7+INT(LOG(ENDREC)/LOG(10))+INT(LOG(RECNO())/LOG(10)) SAY ENDREC
??' records. '
??'Data base in use: '
?? OSS
@ 1,2+INT(LOG(RECNO())/LOG(10)) SAY RECNO()
??' of '
@ 1,0 SAY 'Record No.'
DO CASE
CASE RECNO()=ENDREC
?'End of listing'
CASE RECNO()=1
?'Beginning of listing'
ENDCASE
CASE ENDREC=1
?'There is only 1 record in this listing.'
ENDCASE
@ 3,0 SAY INSTNAME
@ 3,23 SAY SERIALNUM
@ 3,40 SAY TVANUMBER
@ 3,57 SAY CALIBDATE
@ 3,70 SAY 'NEXT DATE'
DO CASE
CASE BY_DATE=100
@ 5,56 SAY TDREMARK
CASE BY_DATE=200
@ 5,58 SAY DREMARK
ENDCASE
@ 6,0 SAY INST_TYPE
@ 6,23 SAY SERIAL_NO
@ 6,40 SAY TVA_NO
@ 6,58 SAY CALIB_DATE
@ 6,70 SAY CAL_DUE_DT
PT=0
IF CAT3ABB $ SUBCATID
?'/'
?? CATEGORY3
??'/ '
PT=1
ENDIF
IF SUB1ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT1
??') '
PT=1
ELSE
??'('
?? SUBCAT1
??') '
ENDIF
ENDIF
IF SUB2ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT2
??') '
PT=1
ELSE
??'('
?? SUBCAT2
??') '
ENDIF
ENDIF
IF SUB3ABB $ SUBCATID
IF PT=0
?'('
?? SUBCAT3
??') '
PT=1
ELSE
??'('
?? SUBCAT3
??') '
ENDIF
ENDIF
@ 9,0 SAY LOCATNAME
??': '
?? LOCATION
IF CALIB_INT>0.AND.CALIB_INT<99
??' '
?? CALINTERVL
??': '
?? CALIB_INT
??' months'
ENDIF
DO CASE
CASE CALIB_INT=99
@ 9,60 SAY '/'
?? CATEGORY2
??'/'
CASE CALIB_INT=0
@ 9,60 SAY '/'
?? CATEGORY3
??'/'
ENDCASE
@ 11,0 SAY REMARK
@ 14,0 SAY 'LAST UPDATE:'
@ 14,14 SAY LAST_UPDAT
N4="K"
DO WHILE ASC(N4)#0.AND.N4#' ' .AND.;
N4#'P'.AND.N4#'U'.AND.N4#'D'.AND.N4#'E'.AND.N4#'B'
@ 16,0 SAY 'Press SPACEBAR to see the next record.'
@ 17,0 SAY 'Press "P" to see previous record.'
IF ENDREC>7
?'Press "U" to go up 7 records.'
?'Press "D" to go down 7 records.'
ENDIF
?'Press "E" to go to the ending (last) record.'
?'Press "B" to go to the beginning (first) record.'
?
WAIT 'Press "RETURN" to return to a previous menu.' TO N4
N4=UPPER(N4)
ENDDO
DO CASE
CASE N4='P' .AND. RECNO() # 1
GO RECNO()-1
CASE N4='P' .AND. RECNO() = 1
GO BOTTOM
CASE ASC(N4)=0
IF (MULTTV=1.OR.MULTSN=1).AND.MODFILE=0
ZAP
USE
SELECT 1
ENDIF
RETURN
CASE N4=' '.AND.ENDREC=RECNO()
GO TOP
CASE N4=' '
SKIP
CASE N4='D'
IF ENDREC>7
IF ENDREC-RECNO()>6
GO RECNO()+7
ELSE
GO RECNO()+7-ENDREC
ENDIF
ELSE
N4='Z'
ENDIF
CASE N4='U'
IF ENDREC>7
IF RECNO()>7
GO RECNO()-7
ELSE
GO ENDREC-7+RECNO()
ENDIF
ELSE
N4='Z'
ENDIF
CASE N4='E'
GO BOTTOM
CASE N4='B'
GO TOP
ENDCASE
ENDDO
ENDIF
SET DELETED ON
IF (MULTTV=1.OR.MULTSN=1).AND.MODFILE=0
ZAP
USE
SELECT 1
ENDIF
RETURN